Visual Basic 5 Developer's Kit/vb5 dev kit.iso/dev/f1ocx/vcform1.3/VB4/SSMDI/SSMDI.BAS

BASIC Source File | 1995-09-15 | 25.2 KB | 791 lines

Attribute VB_Name = "SSMDI1"
Option Explicit

'' This variable is used to name the worksheets in each
'' child window.
Global gNewSSCount As Integer

'' These variables are used for the color controls on the toolbar
Global TextOrFillColorFlag As Integer
Global CurrentFillColorIndex As Integer
Global CurrentTextColorIndex As Integer

'' These are used for the Format Painter command
Global FormatPainterFlag As Integer
Global FmtPntStartRow As Integer
Global FmtPntEndRow As Integer
Global FmtPntStartCol As Integer
Global FmtPntEndCol As Integer


'' Used for reading metafiles
Type Rect
    bbLeft As Integer
    bbTop As Integer
    bbRight As Integer
    bbBottom As Integer
End Type

Type APMFILEHEADER
    key As Long
    hmf As Integer
    bbox As Rect
    inch As Integer
    reserved As Long
    checksum As Integer
End Type

Sub AddDecimalPlace(AddingDigits As Integer)

    Dim TheFormat As String, TheNewFormat As String, TheChar As String
    Dim TheFormatLen As Integer, FromPointer As Integer
    Dim DecimalPointFound As Integer, ScientificFound As Integer
    Dim SS As Object


    ' This routine parses the format strings associated with the selected cell
    ' and either adds or subtracts a decimal place depending on the setting of
    ' AddingDigits.  It is not internationalized and will only work with
    ' American settings (i.e. period for decimal, comma for thousands).

    ' If no active sheet then don't do anything
    If Not (MainFrame.ActiveForm Is Nothing) Then

        ' Save the object into a variable to save on typing.
        Set SS = MainFrame.ActiveForm.SS

        ' Get the format for the active cell.
        TheFormat = SS.NumberFormat

        ' Don't handle the percentage formats
        If TheFormat = "# ?/?" Or TheFormat = "# ??/??" Then
            Beep
            SS.SetFocus
            Exit Sub
        End If

        ' FromPointer is moved through the original string one character at a time.  Format
        ' characters are copied to TheNewFormat and special cases handled individually.

        TheFormatLen = Len(TheFormat)
        FromPointer = 1

        While FromPointer <= TheFormatLen

            TheChar = Mid$(TheFormat, FromPointer, 1)

            ' Process numbers
            If TheChar = "0" Or TheChar = "#" Then

                ' If adding digits then find the decimal or add one if there is none
                If AddingDigits = True Then
                    DecimalPointFound = False
                    ScientificFound = False
                    Do While FromPointer <= TheFormatLen
                        TheChar = Mid$(TheFormat, FromPointer, 1)
                        If TheChar = "." Then DecimalPointFound = True
                        If TheChar = "E" Or TheChar = "e" Then ScientificFound = True
                        If TheChar <> "0" And TheChar <> "#" And TheChar <> "." And TheChar <> "," Then Exit Do
                        TheNewFormat = TheNewFormat + TheChar
                        FromPointer = FromPointer + 1
                    Loop

                    ' Add the decimal point if it didn't have one before
                    If Not DecimalPointFound Then
                        TheNewFormat = TheNewFormat + "."
                    End If

                    ' Now add the new decimal place and we're done
                    TheNewFormat = TheNewFormat + "0"

                ' Removing Digits
                Else
                    DecimalPointFound = 0
                    ScientificFound = False
                    Do While FromPointer <= TheFormatLen
                        TheChar = Mid$(TheFormat, FromPointer, 1)
                        If TheChar = "." Then DecimalPointFound = Len(TheNewFormat) + 1
                        If TheChar = "E" Or TheChar = "e" Then ScientificFound = True
                        If TheChar <> "0" And TheChar <> "#" And TheChar <> "." And TheChar <> "," Then Exit Do
                        TheNewFormat = TheNewFormat + TheChar
                        FromPointer = FromPointer + 1
                    Loop

                    If DecimalPointFound = 0 Then
                        Beep
                    Else
                        ' Remove the rightmost character (either a 0 or a ".")
                        TheNewFormat = Left$(TheNewFormat, Len(TheNewFormat) - 1)
                        ' If there's only a decimal point left at the end, remove it
                        If Right$(TheNewFormat, 1) = "." Then
                            TheNewFormat = Left$(TheNewFormat, Len(TheNewFormat) - 1)
                        End If
                    End If
                End If

                ' If we weren't at the end of the string, add the last character on
                If FromPointer <= TheFormatLen Then
                    TheNewFormat = TheNewFormat + TheChar
                End If

                ' If scienticic notation, then skip the rest of this number format
                If ScientificFound Then
                    Do While FromPointer <= TheFormatLen
                        FromPointer = FromPointer + 1
                        TheChar = Mid$(TheFormat, FromPointer, 1)
                        TheNewFormat = TheNewFormat + TheChar
                        If TheChar <> "0" And TheChar <> "+" And TheChar <> "-" Then Exit Do
                    Loop
                End If

            ' Skip everything in the boxes (Colors or Conditionals)
            ElseIf TheChar = "[" Then
                Do While FromPointer <= TheFormatLen
                    TheChar = Mid$(TheFormat, FromPointer, 1)
                    TheNewFormat = TheNewFormat + TheChar
                    If TheChar = "]" Then Exit Do
                    FromPointer = FromPointer + 1
                Loop

            'Skip everything in quotes
            ElseIf TheChar = Chr$(34) Then
                Do While FromPointer <= TheFormatLen
                    TheChar = Mid$(TheFormat, FromPointer, 1)
                    TheNewFormat = TheNewFormat + TheChar
                    If TheChar = Chr$(34) Then Exit Do
                    FromPointer = FromPointer + 1
                Loop

            ' Copy the "\" or "_" and the next character without change
            ElseIf TheChar = "_" Or TheChar = "\" Then
                TheNewFormat = TheNewFormat + TheChar
                FromPointer = FromPointer + 1
                TheChar = Mid$(TheFormat, FromPointer, 1)
                TheNewFormat = TheNewFormat + TheChar

            ' All other characters are copied across without changing
            Else
                TheNewFormat = TheNewFormat + TheChar
            End If

            FromPointer = FromPointer + 1
        Wend


        ' Handle General format separately
        If TheNewFormat = "General" Then
            If AddingDigits = True Then
                TheNewFormat = "0.0"
            Else
                Beep
            End If
        End If

        ' Set the decimal places for each cell.
        SS.NumberFormat = TheNewFormat

    End If

    SS.SetFocus

End Sub

Sub C_AutoSum()

   Dim OldRow1%, OldRow2%, OldCol1%, OldCol2%, OldRow%, OldCol%
   Dim TheRow%, TheCol%, TheType%
   Dim TheFormula$

   '' This function partly emulates the function of Excel's AutoSum command.  It automatically
   '' creates a formula that sums the cells above it.  If a range is selected then it will
   '' automatically fill the range with the new sum formula.

   '' Unlike Excel, it only sums cells above it (and not to the left).  This extension could
   '' easily be added using the simple framework below.

   If SSIsActiveForm() Then  ' Make sure there is an active worksheet

      '' Save the original range information for later
      OldRow = MainFrame.ActiveForm.SS.Row            '' Current Row
      OldCol = MainFrame.ActiveForm.SS.Col            '' Current Column
      OldRow1 = MainFrame.ActiveForm.SS.SelStartRow   '' Current Selection
      OldRow2 = MainFrame.ActiveForm.SS.SelEndRow     '' "
      OldCol1 = MainFrame.ActiveForm.SS.SelStartCol   '' "
      OldCol2 = MainFrame.ActiveForm.SS.SelEndCol     '' "

      TheRow = OldRow ' Get the row and colum of the current cell
      TheCol = OldCol ' so we can look above it for a range to sum

      If TheRow = 1 Then  ' Can't do it if this is row 1
         Beep
         Exit Sub

      Else

         '' Look above this cell for numbers or formulas returning numbers.  Ignore all blank cells.

         TheRow = TheRow - 1
         Do
            TheType = MainFrame.ActiveForm.SS.TypeRC(TheRow, TheCol)
            If Abs(TheType) = 1 Then  ' 1 (Number) or -1 (Number Formula) are valid cell types to sum
               Exit Do
            ElseIf Abs(TheType) > 1 Then ' Not a valid type (text, error, logical) so return error
               Beep
               Exit Sub
            End If

            TheRow = TheRow - 1

            If TheRow < 1 Then ' If we made it to the top and have not found a number cell then error
               Beep
               Exit Sub
            End If
         Loop

         '' We found the first number cell, now keep moving up until a non-numeric cell is found
         Do While TheRow > 0
            TheType = MainFrame.ActiveForm.SS.TypeRC(TheRow, TheCol)
            If Abs(TheType) <> 1 Then  ' 1 (Number) or -1 (Number Formula) are valid cell types to sum
               Exit Do
            End If
               TheRow = TheRow - 1
         Loop

         '' Create a new selection based on the range we just found
         MainFrame.ActiveForm.SS.SelStartRow = TheRow + 1
         MainFrame.ActiveForm.SS.SelEndRow = OldRow - 1
         MainFrame.ActiveForm.SS.SelStartCol = OldCol1
         MainFrame.ActiveForm.SS.SelEndCol = OldCol1

         '' The Selection property contains a string representation of the selection
         TheFormula = "Sum(" + MainFrame.ActiveForm.SS.Selection + ")"

         '' Put the new sum into the first cell in the range
         MainFrame.ActiveForm.SS.Row = OldRow1
         MainFrame.ActiveForm.SS.Col = OldCol1
         MainFrame.ActiveForm.SS.Formula = TheFormula

         '' Put everything back the way we started
         MainFrame.ActiveForm.SS.Row = OldRow
         MainFrame.ActiveForm.SS.Col = OldCol
         MainFrame.ActiveForm.SS.SelStartRow = OldRow1
         MainFrame.ActiveForm.SS.SelEndRow = OldRow2
         MainFrame.ActiveForm.SS.SelStartCol = OldCol1
         MainFrame.ActiveForm.SS.SelEndCol = OldCol2

         '' Copy the formula right to fill the range (the range may only be one cell)
         '' Formula cell references will adjust automatically
         MainFrame.ActiveForm.SS.EditCopyRight

      End If
   End If

End Sub

Sub C_Clear()

   '' Clear the current worksheet
   On Error Resume Next
   If SSIsActiveForm() Then
      MainFrame.ActiveForm.SS.EditClear (F1ClearAll)
   End If

End Sub

Sub C_Copy()

   If SSIsActiveForm() Then
      Call ShowSSError(MainFrame.ActiveForm.SS.EditCopy)
   End If

End Sub

Sub C_Cut()

   If SSIsActiveForm() Then
      Call ShowSSError(MainFrame.ActiveForm.SS.EditCut)
   End If

End Sub

Sub C_New()

   On Error GoTo CantCreateNewOne
   Dim SS As New VCIChildForm       '' Create a new worksheet and
   SS.Visible = True                '' make it visible
   Exit Sub

CantCreateNewOne:
   MsgBox "Unable to create new worksheet."

End Sub

Sub C_Paste()

   If SSIsActiveForm() Then
      Call ShowSSError(MainFrame.ActiveForm.SS.EditPaste)
   End If

End Sub

Sub C_Print()

   If SSIsActiveForm%() Then
      Call ShowSSError(MainFrame.ActiveForm.SS.FilePrint(True))
   End If

End Sub

Sub C_Save()

   If SSIsActiveForm() Then
      If Left(MainFrame.ActiveForm.SS.TableName, 5) = "Sheet" Then
         Call SSMDISaveAsFile
      Else
         On Error GoTo CantSave
         MainFrame.ActiveForm.SS.Write MainFrame.ActiveForm.SS.TableName, MainFrame.ActiveForm.SS.Tag
         Exit Sub
CantSave:
         MsgBox "Unable to save " & MainFrame.ActiveForm.SS.TableName
         Exit Sub
      End If
   End If

End Sub

Sub C_Sort(ascending%)

   Dim Srow1%, Srow2%, Scol1%, Scol2%, key1%, key2%, Key3%

   If SSIsActiveForm() Then
      Srow1 = MainFrame.ActiveForm.SS.SelStartRow
      Srow2 = MainFrame.ActiveForm.SS.SelEndRow
      Scol1 = MainFrame.ActiveForm.SS.SelStartCol
      Scol2 = MainFrame.ActiveForm.SS.SelEndCol
      key1 = 1
      key2 = 1
      Key3 = 1
      If Scol2 - Scol1 > 0 Then key2 = 2
      If Scol2 - Scol1 > 1 Then Key3 = 3

      If Not ascending Then
         key1 = -key1
         key2 = -key2
         Key3 = -Key3
      End If
      Call ShowSSError(MainFrame.ActiveForm.SS.Sort3(Srow1, Scol1, Srow2, Scol2, True, key1, key2, Key3))
   End If

End Sub


Sub LayoutToolBars()

    Dim NumBars%
    Dim NewTop%
    Dim Barheight


'' This procedure lays out the toolbars depending on which ones are turned on.

    NumBars = Abs(MainFrame.ViewOBT.Checked + MainFrame.ViewFMT.Checked + MainFrame.ViewFOT.Checked)

    Barheight = MainFrame.Panel3D1.Height
    NewTop = 0

    ' File Open Toolbar
    If MainFrame.ViewFOT.Checked Then
        MainFrame.Panel3D1.Visible = True
        MainFrame.Panel3D1.Width = MainFrame.Width
        MainFrame.Panel3D1.Top = NewTop
        MainFrame.Panel3D1.Left = 0
        NewTop = NewTop + MainFrame.Panel3D1.Height + 5
    End If

    ' Object Toolbar
    If MainFrame.ViewOBT.Checked Then
        MainFrame.Panel3D5.Visible = True
        MainFrame.Panel3D5.Width = MainFrame.Width
        MainFrame.Panel3D5.Top = NewTop
        MainFrame.Panel3D5.Left = 0
        NewTop = NewTop + MainFrame.Panel3D5.Height + 5
    End If

    ' Formatting Toolbar
    If MainFrame.ViewFMT.Checked Then
        MainFrame.Panel3D3.Visible = True
        MainFrame.Panel3D3.Width = MainFrame.Width
        MainFrame.Panel3D3.Top = NewTop
        NewTop = NewTop + MainFrame.Panel3D3.Height + 5
    End If

    ' Adjust size of toolbar frame
    MainFrame.Picture1.Height = NewTop + 50

End Sub

Sub Paint_Reference()

   'MainFrame.RCLabel = MainFrame.ActiveForm.SS.Selection

End Sub

Sub SetBorderStyle(TheStyle As Integer)

    Dim nOutline%, nLeft%, nRight%, nTop%, nBottom%, nShade%
    Dim crOutline&, crLeft&, crRight&, crTop&, crBottom&
    Dim SS As Object

    ' This routine sets the border style of the current selection.  The border
    ' style is passed in through TheStyle.

    ' Get a handle to the current spreadsheet to save typing.
    Set SS = MainFrame.ActiveForm.SS

    ' Set all sides to "Don't Change" (-1 means don't change it)
    nOutline = -1
    nLeft = -1
    nRight = -1
    nTop = -1
    nBottom = -1
    nShade = -1

    ' Set the color of the new borders to Black
    crOutline = 0
    crTop = 0
    crBottom = 0
    crLeft = 0
    crRight = 0

    ' Set the outline for selected cells
    Select Case TheStyle

        Case 0 ' None
            nOutline = 0
            nLeft = 0
            nRight = 0
            nTop = 0
            nBottom = 0

        Case 1 ' Bottom
            nBottom = 1 ' Single Thin Line

        Case 2 ' Left
            nLeft = 1 ' Single Thin Line

        Case 3 ' Right
            nRight = 1 ' Single Thin Line

        Case 4 ' Double Thin Bottom
            nBottom = 6 ' Double Thin Lines

        Case 5 ' Single Medium Bottom
            nBottom = 2 ' Single Medium Line

        Case 6 ' Top/Bottom thin lines
            nTop = 1 ' Single Thin Line
            nBottom = 1 ' Single Thin Line

        Case 7 ' Top Thin, Bottom Double Thin
            nTop = 1 ' Single Thin Line
            nBottom = 6 ' Double Thin Lines

        Case 8 ' Top Thin, Bottom Medium
            nTop = 1 ' Single Thin Line
            nBottom = 2 ' Single Medium Line

        Case 9 ' Outline with separators
            nTop = 1 ' Single Thin Line
            nBottom = 1 ' Single Thin Line
            nLeft = 1 ' Single Thin Line
            nRight = 1 ' Single Thin Line

        Case 10 ' Outline Thin
            nOutline = 1 ' Single Thin Line

        Case 11 ' Outline Medium
            nOutline = 2 ' Single Medium Line

    End Select

    ' Set the new border
    SS.SetBorder nOutline, nLeft, nRight, nTop, nBottom, nShade, crOutline, crLeft, crRight, crTop, crBottom

    ' Clean up
    BorderForm.Hide
    SS.SetFocus

End Sub

Sub SetObjectColor(ThePaletteEntry As Integer)

    Dim fColor As Long
    Dim bColor As Long
    Dim ThePattern As Integer
    Dim TheRow As Integer, TheCol As Integer
    Dim ObjectCount As Integer
    Dim TheObjectCount As Integer
    Dim TheObjectID As Long
    Dim TheObjectType As Integer
    Dim StartRow As Integer, EndRow As Integer, StartCol As Integer, EndCol As Integer
    Dim SS As Object

    ' These are for the object descriptions
    Dim TheStyle As Integer
    Dim TheColor As Long
    Dim TheWeight As Integer

    ' These are for the font description of a cell
    Dim pFont As String
    Dim pSize As Integer
    Dim pBold As Boolean
    Dim pItalic As Boolean
    Dim pUnderline As Boolean
    Dim pStrikeout As Boolean
    Dim pcrColor As Long
    Dim pOutline As Boolean
    Dim pShadow As Boolean

    '' This procedure changes the foreground color of the currently selected
    '' object.  The object may be the font color, or a drawing object like a
    '' line or rectangle, or it may be the foreground of the cells in the
    '' current selection.

    '' Multiple objects are handled, but multiple selections are not.  Therefore,
    '' if there is more than one cell selection, only the current selection
    '' will be changed.  Multiple selections can easily be added if you like.

    '' If the object we are operating on is a cell, there is a global flag
    '' called 'TextOrFillColorFlag' that determines whether we are changing
    '' the cell text color or the cell pattern color.

    ' If no active sheet then don't do anything
    If Not (MainFrame.ActiveForm Is Nothing) Then

        ' Save the object into a variable to save on typing.
        Set SS = MainFrame.ActiveForm.SS

        ' Turn off the Selection Change Event so we don't do all the
        ' toolbar updating while formatting.
        SS.DoSelChange = False

        '' This section handles the drawing objects.

        ' If there are no cell selections then see if there are object selections
        If SS.SelectionCount = 0 Then
            TheObjectCount = SS.ObjGetSelectionCount
            If TheObjectCount > 0 Then
                For ObjectCount = 1 To TheObjectCount
                    SS.ObjGetSelection ObjectCount - 1, TheObjectID
                    TheObjectType = SS.ObjGetType(TheObjectID)

                    ' If it's a line then change the line color
                    If TheObjectType = F1ObjLine Then
                        SS.GetLineStyle TheStyle, TheColor, TheWeight
                        TheColor = SS.PaletteEntry(ThePaletteEntry)
                        SS.SetLineStyle TheStyle, TheColor, TheWeight

                    ' If it's a filled object, change the fill coloe
                    ElseIf TheObjectType = F1ObjArc Or TheObjectType = F1ObjOval Or TheObjectType = F1ObjPolygon Or TheObjectType = F1ObjRectangle Then
                        SS.GetPattern ThePattern, fColor, bColor
                        fColor = SS.PaletteEntry(ThePaletteEntry)
                        SS.SetPattern ThePattern, fColor, bColor
                    End If

                Next ObjectCount
            End If

        '' This section handles cell selections

        Else
            ' Get the selection coordinates.  We have to look at each cell individually.
            StartRow = SS.SelStartRow
            EndRow = SS.SelEndRow
            StartCol = SS.SelStartCol
            EndCol = SS.SelEndCol

            ' Set the selection back to a single cell.
            SS.SelStartRow = SS.Row
            SS.SelStartCol = SS.Col
            SS.SelEndRow = SS.Row
            SS.SelEndCol = SS.Col

            ' Set the foreground color or text color of each cell.
            ' If setting the fill color and the cell has no pattern
            ' then set the pattern to 1 (solid).
            For TheRow = StartRow To EndRow
                For TheCol = StartCol To EndCol
                    SS.Row = TheRow
                    SS.Col = TheCol
                    If TextOrFillColorFlag = 0 Then '' Set Fill Color
                        SS.GetPattern ThePattern, fColor, bColor
                        ThePattern = IIf(ThePattern = 0, 1, ThePattern)
                        fColor = SS.PaletteEntry(ThePaletteEntry)
                        SS.SetPattern ThePattern, fColor, bColor
                    Else '' Set Text Color
                        SS.GetFont pFont, pSize, pBold, pItalic, pUnderline, pStrikeout, pcrColor, pOutline, pShadow
                        pcrColor = SS.PaletteEntry(ThePaletteEntry)
                        SS.SetFont pFont, -pSize, pBold, pItalic, pUnderline, pStrikeout, pcrColor, pOutline, pShadow
                    End If
                Next TheCol
            Next TheRow

            ' Restore selection
            SS.SelStartRow = StartRow
            SS.SelEndRow = EndRow
            SS.SelStartCol = StartCol
            SS.SelEndCol = EndCol
            SS.Row = StartRow
            SS.Col = StartCol
        End If

    SS.DoSelChange = False
    SS.SetFocus

    End If

End Sub

Sub ShowSSError(ByVal Er As Integer)

   Dim ssError As String

   If Er <> 0 And Er <> 23 Then
      ssError = Space$(256)
      ssError = MainFrame.ActiveForm.SS.ErrorNumberToText(Er)
   End If

End Sub

Sub SSColorDlg(PosX As Long, PosY As Long)

    ' If there is a worksheet then load color form
    If Not (MainFrame.ActiveForm Is Nothing) Then
        Load ColorForm
        ColorForm.Left = PosX
        ColorForm.Top = PosY
        ColorForm.Show
    End If

End Sub

Function SSGetActiveHSS&()
   SSGetActiveHSS& = MainFrame.ActiveForm.SS.SS
End Function

Function SSGetActiveSS()
   SSGetActiveSS = MainFrame.ActiveForm.SS
End Function

Function SSIsActiveForm%()

   Dim bRet%

   bRet% = False
   If Forms.Count > 1 Then
      bRet% = True
   End If
   SSIsActiveForm% = bRet%

End Function

Sub SSMDIOpenFile(OptionalFileName As String)

   Dim FileName As String, FileType%
   Dim Er As Integer

   FileName = Space$(256)
   If Not SSIsActiveForm Then
      Call C_New
      If Not (MainFrame.ActiveForm Is Nothing) Then
         MainFrame.ActiveForm.SetFocus
      End If
   End If

   On Error GoTo Cancel

   If OptionalFileName = "" Then
      Er = MainFrame.ActiveForm.SS.OpenFileDlg("Formula One Demo", MainFrame.hWnd, FileName)
   Else
      FileName = OptionalFileName
      Er = 0
   End If

   If Er <> 0 Then
      Call ShowSSError(Er)
   Else
      On Error GoTo CantCreateIt
      Dim NewBook As New VCIChildForm
      On Error GoTo UnloadIt

      Er = NewBook.SS.Read(FileName, FileType)
      NewBook.SS.TableName = FileName
      NewBook.Caption = FileName
      NewBook.Visible = True
      NewBook.SS.Tag = FileType
      Exit Sub

Cancel:
      If Er <> 23 Then
         Call ShowSSError(Er)
      End If
      Exit Sub

CantCreateIt:
      MsgBox "Unable to create " & FileName
      Exit Sub

UnloadIt:
      Unload NewBook
      MsgBox "Unable to load " & FileName

      Exit Sub
    End If

End Sub

Sub SSMDISaveAsFile()

   Dim FileName As String
   Dim Er As Integer
   Dim FileType As Integer

   FileName = Space$(256)
   On Error GoTo Cancel
   Er = MainFrame.ActiveForm.SS.SaveFileDlg("Formula One Demo", FileName, FileType)

   If Er <> 0 Then
      Call ShowSSError(Er)
   Else
      On Error GoTo CantWriteIt
      MainFrame.ActiveForm.SS.Write FileName, FileType
      MainFrame.ActiveForm.SS.TableName = FileName
      MainFrame.ActiveForm.Caption = FileName
      MainFrame.ActiveForm.SS.Tag = FileType
      Exit Sub

Cancel:
   If Er <> 23 Then
      Call ShowSSError(Er)
   End If
   Exit Sub

CantWriteIt:
      MsgBox "Unable to write " & FileName
      Exit Sub
   End If
End Sub

Sub UpdateTextAndFillColors()

    Dim SS As Object

    '' This procedure keeps the colors updated on the toolbar
    Set SS = MainFrame.ActiveForm.SS
    MainFrame.lblTextColor.BackColor = SS.PaletteEntry(CurrentTextColorIndex)
    MainFrame.lblFillColor.BackColor = SS.PaletteEntry(CurrentFillColorIndex)

End Sub